SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00003 1 08-24-9413:36ALL DAVID ADAMSON EXE Menu System SWAG9408 ±Æk■ 180 U {πHere is a good scrolling menu bar program written in TP 5.5. Theπcode is very clean and well commented.π}ππprogram exemenu; { version 2.2 }ππππ(****************************************** 1991 J.C. Kessels ****ππThis is freeware. No guarantees whatsoever. You may change it, use it,πcopy it, anything you like.πππJ.C. KesselsπPhilips de Goedelaan 7π5615 PN EindhovenπNetherlandsπ********************************************************************)πππ{$M 3000,0,0} { No heap, or we can't use 'exec'. }πππuses dos;πππππconstπ(* English version: *)π StrCopyright = 'EXEMENU v2.2, 1991 J.C. Kessels';{ Name of program. }π StrBusy = 'Busy....'; { Program is busy message. }π StrHelp = 'Enter=Start ESC=Stop'; { Bottom-left help message.}π StrStart = 'Busy starting program: '; { Start a program message. }π { Wrong DOS version message. }π StrDos = 'Sorry, this program only works with DOS versions 3.xx and above.';π { Unrecognised error message. }π StrError = 'EXEMENU: unrecognised error caused program termination.';π StrExit = 'That''s it, folks!'; { Exit message. }π(* Dutch version: *)π(*π StrCopyright = 'EXEMENU v2.2, 1991 J.C. Kessels'; { Naam van het programma.}π StrHelp = 'Enter=Start ESC=Stop'; { Bodem-links hulp boodschap.}π StrBusy = 'Bezig....'; { Ik ben bezig boodschap.}π { Bij het starten van een programma. }π StrStart = 'Bezig met starten van: ';π { Foutboodschap als de DOS versie niet goed is. }π StrDos = 'Sorry, dit programma werkt slechts met DOS versie 3.xx en hoger.';π { Onbekende fout boodschap. }π StrError = 'EXEMENU: door onbekende fout voortijdig beëindigd.';π StrExit = 'Exemenu is geëindigd.'; { Stop EXEMENU boodschap. }π*)ππ DirMax = 1000; { Number of entries in directory array. }ππtypeπ Str90 = string[90]; { We don't need anything longer than this. }ππvarπ VidStore : array[0..3999] of char; { Video screen storage. }π Dir : array[1..DirMax] of record {The directory is loaded into this array.}π attr : byte; { 1: directory, 2: file.}π name : NameStr; { Name of file/directory. }π ext : ExtStr; { Extension of file. }π end;π DirTop : word; { Last active entry in Dir array. }π DirHere : word; { Current selection in Dir array. }π DirPath : pathstr; { The path of the Loaded directory. }π OldPath : PathStr; { The current directory at startup of EXEMENU. }π BasicPath : PathStr; { The path to the basic interpreter. }π OldCursor : word; { Saved cursor shape. }π xy : word; { Cursor on the screen. }π colour : byte; { Colour for the screen. }π vidseg : word; { Segment of the screen RAM. }π regs : registers; { Registers to call the BIOS. }π Inkey : word; { The last pressed key. }π keyflags : byte absolute $0040:$0017; { BIOS keyboard flags. }π ExitSave : pointer; { Address of exit procedure. }π ExitMsg : Str90; { Message to display when exiting. }π DTA : SearchRec; { FindFirst-FindNext buffer. }ππfunction Left(s : Str90; width : byte) : Str90;π{Return Width characters from input string. Add trailing spaces if necessary.}πbeginπif width > length(s) then Fillchar(s[length(s)+1],width-length(s),32);πs[0] := chr(width);πLeft := s;πend;ππprocedure FixupDir;π{ Fixup the DirPath string. }πvarπ drive : char;π i, j : word;πbeginπi := pos(':',DirPath); { Strip the drive from the path. }πif i = 0 thenπ beginπ if (length(Dirpath) > 0) and (Dirpath[1] = '\')π then DirPath := copy(OldPath,1,2) + DirPathπ else if OldPath[length(OldPath)] = '\'π then DirPath := OldPath + DirPathπ else DirPath := OldPath + '\' + DirPath;π i := pos(':',DirPath);π end;πdrive := DirPath[1];πdelete(DirPath,1,i);ππwhile pos('..',DirPath) <> 0 do { Remove embedded ".." }π beginπ i := pos('..',DirPath);π j := i + 2;π if i > 1 then dec(i);π if (i > 1) and (DirPath[i] = '\') then dec(i);π while (i > 1) and (DirPath[i] <> '\') do dec(i);π delete(DirPath,i,j-i);π end;ππ{ Remove embedded ".\" }πwhile pos('.\',DirPath) <> 0 do delete(DirPath,pos('.\',DirPath),2);ππif pos('\',DirPath) = 0 { If no subdirectories.... }π then DirPath := '\'π elseπ begin { Else strip filename from the path.... }π i := pos('.',DirPath);π if i > 0 thenπ beginπ while (i > 0) and (DirPath[i] <> '\') do dec(i);π if i > 0π then DirPath := copy(DirPath,1,i)π else DirPath := '\';π end;π if DirPath[length(DirPath)] <> '\' { maybe add '\' at the end.... }π then DirPath := DirPath + '\';π end;ππDirPath := drive + ':' + DirPath; { Add the drive back to the directory. }ππ{ Translate the Dirpath into all uppercase. }πfor i := 1 to length(DirPath) do DirPath[i] := upcase(DirPath[i]);πend;ππprocedure Show(s : Str90);π{ Display string "s" at "xy", using "colour". This routine uses DMA into theπ video memory. }πbeginπInline(π $8E/$06/>VIDSEG/ {mov es,[>vidseg] ; Fetch video segment in ES.}π $8B/$3E/>XY/ {mov di,[>xy] ; Fetch video offset in DI.}π $8A/$26/>COLOUR/ {mov ah,[>colour] ; Fetch video colour in AH.}π $1E/ {push ds ; Setup DS to stack segment.}π $8C/$D1/ {mov cx,ss}π $8E/$D9/ {mov ds,cx}π $8A/$8E/>S/ {mov cl,[bp+>s] ; Fetch string size in CX.}π $30/$ED/ {xor ch,ch}π $8D/$B6/>S+1/ {lea si,[bp+>s+1] ; Fetch string address in SI.}π $E3/$04/ {jcxz l2 ; Skip if zero length.}π {l1:}π $AC/ {lodsb ; Fetch character from string.}π $AB/ {stosw ; Show character.}π $E2/$FC/ {loop l1 ; Next character.}π {l2:}π $1F/ {pop ds ; Restore DS.}π $89/$3E/>XY); {mov [>xy],di ; Store new XY.}πend;ππprocedure ShowMenu(Message : Str90);π{ Display the screen, with borders, a "Message" in line 2, and the loadedπ directory in the rest of the screen. }πvarπ i : word; { Work variable. }π s : Str90; { Work variable. }π pagetop : word; { Top of the page in the Dir array. }π row : word; { The display row we are busy with. }πbeginπxy := 0; { First line. }πcolour := $13;πif length(StrCopyright) > 76π then i := 76π else i := length(StrCopyright);πs[0] := chr((76 - i) div 2);πFillchar(s[1],ord(s[0]),'═');πShow('╔'+s+'╡');πcolour := $1B;πShow(copy(StrCopyright,1,i));πcolour := $13;πs[0] := chr(76 - length(s) - length(StrCopyright));πFillchar(s[1],ord(s[0]),'═');πShow('╞'+s+'╗║ ');ππcolour := $1E; { Second line. }πShow(left(Message,76));ππcolour := $13; { Third line. }πShow(' ║╟──────────────────────────────────────────────────────────────────────────────╢');ππ{ Display all the directory entries, using the current cursor positionπ to calculate the top-left of the page. }πpagetop := DirHere - DirHere mod 105 + 1;πfor i := pagetop to pagetop + 20 doπ beginπ colour := $13;π Show('║ ');π colour := $1E;π row := 0;π while row <= 84 doπ beginπ if i+row <= DirTopπ then if Dir[i+row].attr = 1π then Show(left(Dir[i+row].name,14))π else Show(left(Dir[i+row].name,8) + '.' + left(Dir[i+row].ext,5))π else Show(' ');π row := row + 21;π end;π colour := $13;π Show(' ║');π end;ππcolour := $13; { Last line. }πShow('╚══╡');πcolour := $1B;πif length(StrHelp) > 74π then i := 74π else i := length(StrHelp);πShow(copy(StrHelp,1,i));πcolour := $13;πs[0] := chr(74-i);πFillchar(s[1],ord(s[0]),'═');πShow('╞'+s+'╝');πend;ππprocedure ShowBar(here : word; onoff : boolean);π{ Display (onoff = true) or remove (onoff = false) the cursor bar at the screenπ location that shows the "here" entry in the Dir array. Every entry has aπ fixed location on the screen. }πvarπ i : word;πbeginπi := Here mod 105 - 1; { Calculate position on screen. }πxy := 484 + (i div 21) * 28 + (i mod 21) * 160;πif onoff { Setup the proper colour. }π then colour := $70π else colour := $1E;πif Here <= DirTop { Display the Dir entry. }π then if Dir[Here].attr = 1π then Show(left(Dir[Here].name,12)) { Directories without a dot. }π else Show(left(Dir[Here].name,8) + '.' + left(Dir[Here].ext,3))π else Show(' '); { Empty entries. }πcolour := $1E; { Reset the colour. }πend;ππprocedure InitVideo;π{ Initialise the video. If not 80x25 then switch to it. Store the screen.π Hide the cursor. }πvarπ i : byte;πbeginπregs.ah := $0F; { If not text mode 3 or 7, then switch to it. }πintr($10,regs);πi := regs.al and $7F;πregs.ah := $03; { Save current cursor shape. BH is active page. }πintr($10,regs);πOldCursor := regs.cx;πif (i <> 3) and (i <> 7) thenπ beginπ regs.al := 3;π regs.ah := 0;π intr($10,regs);π i := 3;π end;ππif i <> 7 { Compute video segment. }π then vidseg := $B800 + (memw[$0040:$004E] shr 4)π else vidseg := $B000 + (memw[$0040:$004E] shr 4);ππmove(mem[vidseg:0],VidStore[0],4000); { Store current screen. }ππregs.cx := $2000; { Hide cursor. }πregs.ah := 1;πintr($10,regs);ππcolour := $1E; { Reset attribute. }πxy := 0; { Reset cursor. }πend;ππprocedure ResetVideo;π{ Reset the video back to it's original contents. Show the cursor. }πbeginπmove(VidStore[0],mem[vidseg:0],4000); { Restore screen. }ππregs.cx := OldCursor; { Reset original cursor chape. }πregs.ah := 1;πintr($10,regs);πend;ππ{$F+}πprocedure ExitCode;π{ Reset display upon exit. This also works for error exit's. }πbeginπResetVideo; { Reset the original display contents. }πif ExitMsg <> '' then writeln(ExitMsg); { Show exit message. }πChDir(OldPath); { Restore current path. }πExitProc := ExitSave; { Reset previous exit procedure. }πend;π{$F-}ππprocedure LoadDir;π{ Load the "DirPath" directory into memory. }πvarπ i : word; { Work variable. }π s : pathstr; { Work variable. }π name : NameStr; { Name of current file. }π ext : ExtStr; { Extension of current file. }π attr : byte; { Attribute of current file. }πbeginπcolour := $1E; { Show "busy" message. }πxy := 164;πShow(left(StrBusy,76));ππFixupDir; { Cleanup the DirPath string. }πDirTop := 0; { Reset pointers into the Dir array.}πDirHere := 1;ππFindFirst(DirPath+'*.*',AnyFile,DTA); { Find first file. }πwhile (DosError = 3) and (length(DirPath) > 3) do { If path not found....}π beginπ i := length(DirPath); { then strip last directory from path. }π if i > 3 then dec(i);π while (i > 3) and (DirPath[i] <> '\') do dec(i);π DirPath := copy(DirPath,1,i);π FindFirst(DirPath+'*.*',AnyFile,DTA); { And try again. }π end;ππwhile DosError = 0 do { For all the files. }π beginπ attr := 0;π if (DTA.attr and Directory) = Directoryπ thenπ begin { Setup for directories. }π name := DTA.name;π ext := '';π if DTA.name <> '.' then attr := 1; { Ignore '.' directory. }π if DTA.name = '..' then name := '..';π endπ elseπ beginπ for i := 1 to length(DTA.name) do { Translate filename to lowercase. }π if DTA.name[i] IN ['A'..'Z'] thenπ DTA.name[i] := chr(ord(DTA.name[i])+32);π i := pos('.',DTA.name); { Split filename in name and extension. }π if i > 0π thenπ beginπ name := copy(DTA.name,1,i-1);π ext := copy(DTA.name,i+1,length(DTA.name)-i);π endπ elseπ beginπ name := DTA.name;π ext := '';π end;π { Ignore unrecognised extensions. }π if (ext = 'com') and (DTA.name <> 'command.com') then attr := 2;π if (ext = 'exe') and (DTA.name <> 'exemenu.exe') then attr := 2;π if (ext = 'bat') and (DTA.name <> 'autoexec.bat') then attr := 2;π if (ext = 'bas') and (BasicPath <> '') then attr := 2;π end;π { If recognised extension or directory, then load into memory. }π if attr > 0 thenπ beginπ i := 1;π while (i <= DirTop) and { Find location where to insert (sort). }π ((attr > Dir[i].attr) orπ ((attr = Dir[i].attr) and (name > Dir[i].name)) orπ ((attr = Dir[i].attr) and (name = Dir[i].name) and (ext > Dir[i].ext)))π do inc(i);π if DirTop < DirMax then inc(DirTop);π if i < DirTop then { Move entries up, to create entry. }π move(Dir[i],Dir[i+1],sizeof(Dir[1]) * (DirTop - i));π if i <= DirMax then { Fill the entry. }π beginπ Dir[i].name := name;π Dir[i].ext := ext;π Dir[i].attr := attr;π end;π end;π FindNext(DTA); { Next item. }π end;ππ{ Analyse the results. If nothing found (maybe disk error), and if we are in aπ subdirectory, then at least add the parent directory. }πif (DirTop = 0) and (length(DirPath) > 3) thenπ beginπ Dir[1].name := '..';π Dir[1].ext := '';π Dir[1].attr := 1;π DirTop := 1;π end;ππend;ππprocedure ExecuteProgram;π{ Execute the program at "DirHere". }πvarπ ProgramPath : pathstr; { Path to the program to execute. }πbeginπ{ Return from this subroutine if there is no program at the cursor. }πif (DirHere < 1) or (DirHere > DirTop) or (Dir[DirHere].attr <> 2) then exit;ππcolour := $1E; { Show "busy" message. }πxy := 164;πShow(left(StrBusy,76));ππ{ Setup path to the program. }πProgramPath := DirPath + Dir[DirHere].name + '.' + Dir[DirHere].ext;ππFindFirst(ProgramPath,AnyFile,DTA); { Test if the path to the program exists. }πif DosError <> 0 then exit; { Exit if error. }πResetVideo; { Reset the video screen. }πwriteln(StrStart,ProgramPath); { Show startup message. }ππChDir(copy(DirPath,1,length(DirPath)-1)); { Change to the directory. }πSwapVectors; { Start program. }πif Dir[DirHere].ext = 'bat' { .BAT files trough the COMMAND.COM. }π then Exec(getenv('COMSPEC'),'/C '+ProgramPath)π else if Dir[DirHere].ext = 'bas' { .BAS trough the basic interpreter. }π then Exec(BasicPath,ProgramPath)π else Exec(ProgramPath,''); { Others directly. }πSwapVectors;ππInitVideo; { Initialise the video. }πShowMenu(StrBusy); { Draw screen with "busy" message. }ππ{ Reset keyboard flags. }πkeyflags := keyflags and $0F; {Capslock, Numlock, ScrollLock and Insert off.}πfillchar(regs,sizeof(regs),#0); { Clear registers. }πregs.ah := 1; { Activate new setting. }πintr($16,regs);ππregs.ah := 1; { Clear the keyboard buffer.}πintr($16,regs);πwhile (regs.flags and fzero) = 0 doπ beginπ regs.ah := 0;π intr($16,regs);π regs.ah := 1;π intr($16,regs);π end;ππInkey := 13;πend;ππvarπ i : word; { Workvariable. }π s : Str90; { Workvariable. }π OldHere, OldPageTop : word; { Determine if cursor has moved. }ππbeginπDirPath := ''; { No directory loaded right now. }πDirTop := 0; { No directory loaded right now. }πExitMsg := StrError; { Reset error message. }πgetdir(0,OldPath); { Save current directory. }πExitSave := ExitProc; { Setup exit procedure. }πExitProc := @ExitCode;πInitVideo; { Initialise the video. }πShowMenu(StrBusy); { Draw screen with "busy" message. }ππif lo(DosVersion) < 3 then { Test DOS version. }π beginπ ExitMsg := StrDos;π halt(1);π end;ππ{ Determine what directory to search for programs. Default is the currentπ directory. Otherwise the first argument after EXEMENU is used as startingπ path. }πif paramcount = 0π then DirPath := OldPathπ else DirPath := paramstr(1);ππ{ Find the basic interpreter somewhere in the path. If not found, then basicπ programs will not be listed. }πBasicPath := Fsearch('GWBASIC.EXE',GetEnv('PATH'));πif BasicPath = '' then BasicPath := Fsearch('GWBASIC.COM',GetEnv('PATH'));πif BasicPath = '' then BasicPath := Fsearch('BASIC.EXE',GetEnv('PATH'));πif BasicPath = '' then BasicPath := Fsearch('BASIC.COM',GetEnv('PATH'));πif BasicPath = '' then BasicPath := Fsearch('BASICA.EXE',GetEnv('PATH'));πif BasicPath = '' then BasicPath := Fsearch('BASICA.COM',GetEnv('PATH'));πif BasicPath <> '' then BasicPath := FExpand(BasicPath);ππLoadDir; { Load the directory into memory. }πShowMenu(DirPath); { Display the directory. }πShowBar(DirHere,true); { Highlight the current choice. }ππ{ The main loop, exited only when the user presses ESC. }πrepeatπ { Wait for a key to be pressed. Place the scancode in the Inkey variable. }π regs.ah := 0;π intr($16,regs);π Inkey := regs.ax;ππ if lo(Inkey) = 13 then { Process ENTER key. }π beginπ ShowBar(DirHere,false); { Remove cursor bar. }π s := ''; { No item stored. }π { If cursor points to a program....}π if DirHere <= DirTop then if Dir[DirHere].attr = 2π thenπ beginπ { Store the item to execute, so we can move the cursor back to it. }π s := Dir[DirHere].name + '.' + Dir[DirHere].ext;π ExecuteProgram; { Then execute the program....}π endπ else if Dir[DirHere].name <> '..' { Else goto the directory....}π then DirPath := fexpand(DirPath+Dir[DirHere].name) + '\'π elseπ begin { Or goto the parent directory. }π i := length(DirPath) - 1;π while (i >= 1) and (DirPath[i] <> '\') do dec(i);π {Store the directory we just left, so we can move the cursor to it.}π s := copy(DirPath,i+1,length(DirPath)-i-1);π if i > 0π then DirPath := copy(DirPath,1,i)π else DirPath := '\';π end;π LoadDir; { Reload the directory. }π { If an item was stored, then find it, and move the cursor to it. }π if s <> '' thenπ beginπ DirHere := 1;π if pos('.',s) = 0π then while (DirHere < DirTop) and (Dir[DirHere].name <> s) doπ inc(DirHere)π else while (DirHere < DirTop) andπ (Dir[DirHere].name + '.' + Dir[DirHere].ext <> s) do inc(DirHere);π if (DirHere <= DirTop) and (π ((pos('.',s) = 0) andπ (Dir[DirHere].name <> s)) orπ ((pos('.',s) > 0) andπ (Dir[DirHere].name + '.' + Dir[DirHere].ext <> s)) )π then DirHere := 1;π end;π ShowMenu(DirPath); { Show the menu. }π ShowBar(DirHere,true); { Show cursor bar. }π end;ππ { Process cursor movement keys. }π OldHere := DirHere; {Remember current cursor, to determine if it has moved.}π if (Inkey = $4800) and (DirHere > 1) then dec(DirHere); { arrow-up.}π if (Inkey = $5000) and (DirHere < DirTop) then inc(DirHere); {arrow-down.}π if (Inkey = $4D00) or (lo(Inkey) = 9) then {arrow-right or tab.}π if DirHere + 21 <= DirTopπ then DirHere := DirHere + 21π else DirHere := DirTop;π if (Inkey = $4B00) or (Inkey = $0F00) then { arrow-left or shift-tab. }π if DirHere > 21π then DirHere := DirHere - 21π else DirHere := 1;π if (Inkey = $5100) and (DirHere < DirTop) then { pgdn. }π if DirTop > 105π then if DirHere + 105 < DirTopπ then DirHere := DirHere + 105π else DirHere := DirTopπ else if (DirHere - 1) mod 21 = 20π then if DirHere + 21 <= DirTopπ then DirHere := DirHere + 21π else DirHere := DirTopπ else if DirHere - (DirHere - 1) mod 21 + 20 < DirTopπ then DirHere := DirHere - (DirHere - 1) mod 21 + 20π else DirHere := DirTop;π if (Inkey = $4900) and (DirHere > 1) then { pgup. }π if DirTop > 105π then if DirHere > 105π then DirHere := DirHere - 105π else DirHere := 1π else if (DirHere - 1) mod 21 = 0π then if DirHere > 21π then DirHere := DirHere - 21π else DirHere := 1π else DirHere := DirHere - (DirHere - 1) mod 21;π if Inkey = $4700 then DirHere := 1; { home. }π if Inkey = $4F00 then DirHere := DirTop; { end. }π if lo(Inkey) > 31 then {Process a character inkey. }π beginπ i := 1;π while (i <= DirTop) and (Dir[i].name[1] <> chr(lo(Inkey))) do inc(i);π if i <= DirTop then DirHere := i;π end;π if DirHere = 0 then DirHere := 1; { Correct for empty list. }π { If the cursor has moved off the screen, then redraw the menu. }π if OldHere - OldHere mod 105 + 1 <> DirHere - DirHere mod 105 + 1 thenπ beginπ ShowBar(OldHere,false);π ShowMenu(DirPath);π ShowBar(DirHere,true);π OldHere := DirHere;π end;π if OldHere <> DirHere then { If the cursor has moved, then redraw it. }π beginπ ShowBar(OldHere,false);π ShowBar(DirHere,true);π end;ππuntil lo(Inkey) = 27; { Until ESC key pressed. }ππExitMsg := StrExit; { Exit with message. }πend.π 2 08-24-9413:45ALL FRANK DIACHEYSN Multiple DOS Calls SWAG9408 ,t╪ 11 U {π Coded By Frank Diacheysn Of Gemini Softwareππ FUNCTION MASSEXECππ Input......: DOS Command Line(s)π :π :π :π :ππ Output.....: Logicalπ : TRUE = No Errors During Executionπ : FALSE = Error Occured During Executionπ :π :ππ Example....: IF MASSEXEC('DIR,PAUSE') THENπ : WriteLn('No Errors!')π : ELSEπ : WriteLn('DOS Error Occured!');π :ππ Description: Execute One Or More DOS Program Callsπ : (Seperate Calls With A Comma)π :π :π :ππ}πFUNCTION MASSEXEC( S:STRING ):BOOLEAN;π{$M $4000,0,0}πVAR nCount : INTEGER;πVAR ExS : STRING;πVAR Ch : CHAR;πBEGINπ REPEATπ nCount := 0;π ExS := '';π REPEATπ Inc(nCount);π Ch := S[nCount];π IF Ch <> ',' THENπ ExS := ExS + Ch;π UNTIL (Ch = ',') OR (nCount = Length(S));π IF POS(',',S)=0 THENπ S := ''π ELSEπ DELETE(S,1,POS(',',S));π SWAPVECTORS;π EXEC( GETENV('COMSPEC'), '/C '+ ExS );π SWAPVECTORS;π MASSEXEC := DOSERROR = 0;π UNTIL S = '';πEND;π 3 08-24-9413:47ALL MIKE PERRY Menu System SWAG9408 2Lm╖ 83 U {π GG> Could somebody post a message with the Pascal 6.0 source for someπ GG> sort of a scrolling menu system? I do NOT want TurboVision. Iπ GG> HATE OOP. I don't mind records and arrays, but i don't want OOP.π GG> I've done some programming for one myself....π}ππUNIT MPMENU;π{π Written and designed by Michael Perry, (c) 1990 Progressive Computer Serv.ππ A basic, flexible, user-definable menu system using only the most basicπ functions in Turbo Pascal. This unit is easily integratable into yourπ applications and gives you more versatility than most "pull down"-typeπ menu interfaces.ππ License: This unit should NOT be modified and redistributed in sourceπ or object/TPU form. You can modify and use this in any non-π commercial program free-of-charge provided that "Mike Perry"π if credited either in the program or documentation. Use ofπ these routines in a commercially-sold package requires aπ one-time registration fee of $30 to be sent to:ππ Progressive Computer Servicesπ P.O. Box 7638π Metairie, LA 70010ππ Non-commercial users are also invited to register the code.π This insures that updates and future revisions are madeπ available and users are kept informed via mail.πππ Usage: Implementing menus using the MPMENU unit involves just aπ few basic steps. At any point in your program, add codeπ to perform the following actions:ππ 1. Define the menu by assigning values to the MENU_DATAπ record.π 2. Call the procedure MENU(MENU_DATA,RETURNCODE);π 3. Implement a routine to evaluate the value ofπ RETURNCODE and act accordingly. The values ofπ RETURNCODE are as follows:π 0 = ESC pressed (menu aborted)π 1-x = The appropriate option was selected, with 1π being the first menu choice, 2 the second,π etc.ππ Example: Here is a sample main menu using the MENU procedure:π-----------------------------------------------------------------------------π Program DontDoMuch;π Uses Crt,MPMenu;ππ CONST HELL_FREEZES_OVER=FALSE;π VAR CHOICE:BYTE;ππ Beginπ REPEATππ With Menu_Data Do Beginπ Menu_Choices[1]:='1 - First Option '; - define menu choice onscreenπ Row[1]:=10; Column[1]:=30; - where on screen displayedπ Menu_Choices[2]:='2 - Second Option'; - same thing for 2nd choiceπ Row[2]:=12; Column[2]:=30; .π Menu_Choices[3]:='X - Exit Program '; .π Row[3]:=14; Column[3]:=30; .π Onekey:=TRUE; - enable 1-key executionπ Num_Choices:=3; - number of menu choicesπ HiLighted:=112; - highlighted attributeπ Normal:=7; - normal attributeπ End;ππ MENU(MENU_DATA,CHOICE); - call the menu now and wait for userππ Case Choice Of - evaluate user response and actπ 0:Halt; - ESC pressedπ 3:Halt; - option 3, Exit, selectedπ 1:Beginπ - put code here to do menu option 1π End;π 2:Beginπ - put code here to do menu option 2π End;π Endππ UNTIL HELL_FREEZES_OVER; - infinite loop - back to main menuπEnd.π-----------------------------------------------------------------------------π}πINTERFACEππ USES Crt;ππ CONSTπ MAX_CHOICES = 10; { MAX_CHOICES can be changedπ depending upon the highestπ number of options you willπ have on any given menu }ππ TYPEπ MENU_ARRAY = RECORD { record structure for menu }π MENU_CHOICES : ARRAY[1..MAX_CHOICES] OF STRING[50]; { displayed option }π COLUMN : ARRAY[1..MAX_CHOICES] OF BYTE; { column location }π ROW : ARRAY[1..MAX_CHOICES] OF BYTE; { row location }π NUM_CHOICES : BYTE; { # choices on menu }π HILIGHTED : WORD; { attribute for hilight }π NORMAL : WORD; { attributed for normal }π ONEKEY : BOOLEAN; { TRUE for 1-key executionπ}π END;ππ VARπ MENU_DATA : MENU_ARRAY; { global menu variable }ππ{π NOTE: You can define many menu variables simultaneously, but since youπ can generally use only one menu at a time, you can conserveπ memory and program space by re-defining this one MENU_DATA recordπ each time a menu is to be displayed.π}ππ{ internal procedures }π PROCEDURE SHOW_MENU(MENU_DATA:MENU_ARRAY);π PROCEDURE HILIGHT_CHOICE(MENU_DATA:MENU_ARRAY;CHOICENUM:BYTE);π PROCEDURE UNHILIGHT_CHOICE(MENU_DATA:MENU_ARRAY;CHOICENUM:BYTE);π FUNCTION GETKEY(VAR FUNCTIONKEY:BOOLEAN):CHAR;π FUNCTION FOUND_CHOICE(MENU_DATA:MENU_ARRAY;VAR EXITCODE:BYTE;CH:CHAR):BOOLEAN;ππ{ basically, the ONE callable procedure }π PROCEDURE MENU(MENU_DATA:MENU_ARRAY;VAR EXITCODE:BYTE);ππIMPLEMENTATIONπππ(*===========================================================================*)πPROCEDURE SHOW_MENU(MENU_DATA:MENU_ARRAY);π{ display defined menu array }πVAR I:BYTE;πBEGINπ TEXTATTR:=MENU_DATA.NORMAL;π FOR I:=0 TO (MENU_DATA.NUM_CHOICES-1) DO BEGINπ GOTOXY(MENU_DATA.COLUMN[I+1],MENU_DATA.ROW[I+1]);π WRITE(MENU_DATA.MENU_CHOICES[I+1]);π END;πEND;π(*===========================================================================*)πPROCEDURE HILIGHT_CHOICE(MENU_DATA:MENU_ARRAY;CHOICENUM:BYTE);π{ highlight the appropriate menu choice }πBEGINπ GOTOXY(MENU_DATA.COLUMN[CHOICENUM],MENU_DATA.ROW[CHOICENUM]);π TEXTATTR:=MENU_DATA.HILIGHTED;π WRITE(MENU_DATA.MENU_CHOICES[CHOICENUM]);π { below needed if direct screen writing not done }π GOTOXY(MENU_DATA.COLUMN[CHOICENUM],MENU_DATA.ROW[CHOICENUM]);πEND;π(*===========================================================================*)πPROCEDURE UNHILIGHT_CHOICE(MENU_DATA:MENU_ARRAY;CHOICENUM:BYTE);π{ highlight the appropriate menu choice }πBEGINπ GOTOXY(MENU_DATA.COLUMN[CHOICENUM],MENU_DATA.ROW[CHOICENUM]);π TEXTATTR:=MENU_DATA.NORMAL;π WRITE(MENU_DATA.MENU_CHOICES[CHOICENUM]);πEND;π(*===========================================================================*)πFUNCTION GETKEY(VAR FUNCTIONKEY:BOOLEAN):CHAR;π{ read keyboard and return character/function key }πVAR CH: CHAR;πBEGINπ CH:=ReadKey;π IF (CH=#0) THENπ BEGINπ CH:=ReadKey;π FUNCTIONKEY:=TRUE;π ENDπ ELSE FUNCTIONKEY:=FALSE;π GETKEY:=CH;πEND;π(*===========================================================================*)πFUNCTION FOUND_CHOICE(MENU_DATA:MENU_ARRAY;VAR EXITCODE:BYTE;CH:CHAR):BOOLEAN;π{ locate next occurance of menu choice starting with char CH }πVAR I:BYTE; TEMP:STRING;πBEGINπ CH:=UPCASE(CH);π IF EXITCODE=MENU_DATA.NUM_CHOICES THEN BEGINπ TEMP:=MENU_DATA.MENU_CHOICES[1];π IF UPCASE(TEMP[1])=CH THEN BEGINπ UNHILIGHT_CHOICE(MENU_DATA,EXITCODE);π EXITCODE:=1;π HILIGHT_CHOICE(MENU_DATA,EXITCODE);π FOUND_CHOICE:=TRUE;π EXIT;π END;π END;ππ FOR I:=EXITCODE+1 TO MENU_DATA.NUM_CHOICES DO BEGINπ TEMP:=MENU_DATA.MENU_CHOICES[I];π IF UPCASE(TEMP[1])=CH THEN BEGINπ UNHILIGHT_CHOICE(MENU_DATA,EXITCODE);π EXITCODE:=I;π HILIGHT_CHOICE(MENU_DATA,EXITCODE);π FOUND_CHOICE:=TRUE;π EXIT;π END;π END;ππ IF EXITCODE<>1 THEN BEGIN { KILLER RECURSION }π UNHILIGHT_CHOICE(MENU_DATA,EXITCODE);π EXITCODE:=1;π IF FOUND_CHOICE(MENU_DATA,EXITCODE,CH) THEN BEGINπ HILIGHT_CHOICE(MENU_DATA,EXITCODE);π FOUND_CHOICE:=TRUE;π EXIT;π END ELSE HILIGHT_CHOICE(MENU_DATA,EXITCODE);π END ELSE BEGINπ TEMP:=MENU_DATA.MENU_CHOICES[1];π IF UPCASE(TEMP[1])=CH THEN BEGINπ FOUND_CHOICE:=TRUE;π EXIT;π END;π END;π FOUND_CHOICE:=FALSE;πEND;π(*===========================================================================*)πPROCEDURE MENU(MENU_DATA:MENU_ARRAY;VAR EXITCODE:BYTE);π{ display menu and return user's response:π 0 = ESC pressedπ 1-x = appropriate choice selectedππ during operation, variable EXITCODE holds number of currently-selectedπ menu choice.π}πVARπ FNC:BOOLEAN; TEMPATTR:WORD;π CH:CHAR;πBEGINπ TEMPATTR:=TEXTATTR;π IF (EXITCODE=0) OR (EXITCODE>MENU_DATA.NUM_CHOICES) THENπ EXITCODE:=1;π SHOW_MENU(MENU_DATA);π HILIGHT_CHOICE(MENU_DATA,EXITCODE);π REPEATπ CH:=GETKEY(FNC);π IF FNC THEN BEGINπ IF CH=#77 THEN CH:=#80 ELSEπ IF CH=#75 THEN CH:=#72;ππ CASE CH OFπ #72:IF EXITCODE>1 THEN BEGIN { UP }π UNHILIGHT_CHOICE(MENU_DATA,EXITCODE);π EXITCODE:=EXITCODE-1;π END;π #80:IF EXITCODE<MENU_DATA.NUM_CHOICES THEN BEGIN { DOWN }π UNHILIGHT_CHOICE(MENU_DATA,EXITCODE);π EXITCODE:=EXITCODE+1;π END;π #71:IF EXITCODE<>1 THEN BEGIN { HOME }π UNHILIGHT_CHOICE(MENU_DATA,EXITCODE);π EXITCODE:=1;π END;π #79:IF EXITCODE<MENU_DATA.NUM_CHOICES THEN BEGIN { END }π UNHILIGHT_CHOICE(MENU_DATA,EXITCODE);π EXITCODE:=MENU_DATA.NUM_CHOICES;π END;π END; { functionkey CASE }π HILIGHT_CHOICE(MENU_DATA,EXITCODE);π END { if FNC }ππ ELSEπ CASE CH OFπ #27:BEGINπ EXITCODE:=0;π TEXTATTR:=TEMPATTR;π EXIT;π END;π #13:BEGINπ TEXTATTR:=TEMPATTR;π EXIT;π END;π ELSEπ IF FOUND_CHOICE(MENU_DATA,EXITCODE,CH) THENπ IF (MENU_DATA.ONEKEY) THEN BEGINπ TEXTATTR:=TEMPATTR;π EXIT;π END ELSE { nothing }π ELSEπ{ BEGINπ GOTOXY(1,20); used for debuggingπ WRITELN('FNC=',FNC,' KEYVAL=',ORD(CH));π END;π }π END; {case}π UNTIL FALSE;πEND;π(*===========================================================================*)πEND. { of unit MPMENU }ππ
